home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_2 / hexatom2 < prev    next >
Text File  |  1995-03-31  |  12KB  |  332 lines
  1. Article 1103 of comp.sys.handhelds:
  2. Path: en.ecn.purdue.edu!noose.ecn.purdue.edu!samsung!sdd.hp.com!decwrl!shelby!bloom-beacon!eru!luth!sunic!mcsun!hp4nl!charon!cwi.nl
  3. From: jurjen@cwi.nl (Jurjen NE Bos)
  4. Newsgroups: comp.sys.handhelds
  5. Subject: New version of HEXATOM game for HP48SX
  6. Keywords: game
  7. Message-ID: <2012@charon.cwi.nl>
  8. Date: 27 Aug 90 08:12:22 GMT
  9. Sender: news@cwi.nl
  10. Organization: STORC, Veldhoven
  11. Lines: 317
  12.  
  13.  
  14. I had a vary fruitful discussion with Ian Frechett, giving me some ideas to
  15. improve the game.  Here is the result.  I made the following improvements:
  16. - You can mark atoms on the display that you think you know.
  17. - Cheating is impossible: after you saw the atoms, you get a count of right
  18.     and wrong guessed atoms.
  19. - You can see the last move even if you are typing in the next one.
  20. - The number of atoms is visible in the upper left corner.
  21. - The input routine is improved.
  22. - Strings with a line-feed in the will download without problems.
  23.  
  24. For people who don't know the game yet, here an introduction:
  25. Here is the game HEXATOM for the HP48SX.  If you never heard about it, that's
  26. OK, because I invented it a few years ago with a friend.
  27. It looks a little bit like the game "Black Box" (trademark of ?).
  28.  
  29. The rules are as follows:
  30. There is a board consisting of 50 hexagons.  In those hexagons, there
  31. is a number of atoms hidden by your opponenent (in this case, the calculator).
  32. You must try to find the atoms by sending light rays through the grid.
  33. You can send a light ray from any side of the board, so that there are six
  34. directions.
  35.  
  36. A light ray is absorbed if it runs into an atom, and it bounces off if it
  37. comes close to an atom:
  38.       _   _   _   _        _   _   _   _  
  39.     _/ \_/ \_/ \_/ \_    _/ \_/ \_/ \_/ \_
  40.      \_/ \_/*\_/ \_/      \_/ \_/*\_/ \_/ 
  41.     _/ \_/.\_/ \_/ \_    _/ \_/ \_/ \_/ \_
  42.      \_/.\_/ \_/ \_/      \_/ \_/.\_/ \_/ 
  43.     _/.\_/ \_/ \_/ \_    _/ \_/.\_/.\_/ \_
  44.     .\_/ \_/ \_/ \_/      \_/.\_/ \_/.\_/ 
  45.     _/ \_/ \_/ \_/ \_    _/.\_/ \_/ \_/.\_
  46.      \_/ \_/ \_/ \_/     .\_/ \_/ \_/ \_/.
  47.     Absorbed by an atom    Reflected
  48.  
  49. A move is done by sending a light ray.  As reply you get the edge of the board
  50. at which the ray left the board, and "---" if it is absorbed.
  51. Watch out for combinations like this:
  52.       _   _   _   _        _   _   _   _  
  53.     _/ \_/*\_/ \_/ \_    _/ \_/ \_/ \_/ \_
  54.      \_/ \_/ \_/ \_/      \_/ \_/*\_/ \_/ 
  55.     _/ \_/.\_/ \_/ \_    _/ \_/ \_/*\_/ \_
  56.      \_/.\_/*\_/ \_/      \_/ \_/.\_/ \_/ 
  57.     _/.\_/ \_/ \_/ \_    _/ \_/.\_/ \_/ \_
  58.     .\_/ \_/ \_/ \_/      \_/.\_/.\_/ \_/ 
  59.     _/ \_/ \_/ \_/ \_    _/.\_/ \_/ \_/ \_
  60.      \_/ \_/ \_/ \_/     .\_/ \_/.\_/ \_/ 
  61.     Absorbed by two atoms    Double reflection
  62. There is also a triple reflection, which in effect reverses the ray.
  63.  
  64. The game is started by pressing PLAY (the first variable), and then
  65. entering the number of atoms you like.  It gets harder with more atoms,
  66. of course.  I recommend using 2 (boring) to 10 (almost impossible) atoms.
  67.  
  68. The program draws a board on the screen, with the atoms hidden.
  69. You now have the following options:
  70. 1-5 selects a row of tiles (rather wiggly)
  71. A-J selects a column of tiles
  72. S-X selects a side of the tile where the ray will enter the board
  73. Backspace erases the selection
  74. ENTER sends a ray, and tells you the entry and exit position of the ray.
  75. * shows where the atoms are.  Press any key to exit the game.
  76. + enters a guessed atom at the selected location.  To remove a location,
  77.     just select it again and press + again.
  78. (blue) OFF turns the calculator off in the middle of a game.  Convenient as
  79.     boss key :-) .
  80.  
  81. If the game is over, the calculator computes the number of guessed atoms
  82. that are on the correct and incorrect positions.  It also gives the number
  83. of moves and the number of hidden atoms.
  84.  
  85. Some remarks:
  86. - I had a nice idea to get the large GROB to donwload without
  87.     problems.  Probably at lot of people thought of this, but it is
  88.     handy.
  89. - The routine CHECK is nominated for the obfuscated RPL contest.
  90. - I like to have the routine SCAN as fast as possible.  Does someone already
  91.     have the right SYSEVALs handy?  Please contact me if you do.  Saves
  92.     me a lot of time.
  93. Happy playing!
  94.  
  95. @HEXATOM written by Jurjen N.E. Bos
  96. @Revised version
  97. @August, 1990
  98. %%HP: T(3)A(R)F(,);
  99. DIR
  100.   PLAY
  101.     \<< INIT
  102.       WHILE 1
  103.       REPEAT DRM 0 WAIT
  104.     IF DUP 51,1 \=/
  105.     THEN UNMARK
  106.     END
  107.     CASE DUP 20 <
  108.       THEN IP 10 - 2 setm
  109.       END DUP 25 <
  110.       THEN IP 14 - 2 setm
  111.       END DUP 40 \>= OVER 50 < AND
  112.       THEN IP 40 - 3 setm
  113.       END { 82,1 83,1 84,1 72,1 73,1 } OVER POS DUP
  114.       THEN 1 setm DROP
  115.       END DROP { 51,1 55,1 91,3 95,1 75,1 } SWAP POS DUP
  116.       THEN { enter clear OFF guess gmov } SWAP GET EVAL
  117.       END BOOP
  118.     END
  119.       END
  120.     \>>
  121.   NM 0
  122.   GL { }
  123.   AL { }
  124.   LM { }
  125.   ML { }
  126.   INIT
  127.     \<< FIELD PICT STO { } 'ML' STO 0 'NM' STO
  128.       { 5 1 6 } 'LM' STO { } 'GL' STO
  129.       "HEXATOM by Jurjen Bos\010number of atoms:" { "5" { -1 1 } V }
  130.       INPUT OBJ\-> PICT (-6;68) 3 PICK 1 \->GROB REPL { }
  131.       DO RAND 5 * IP 1 + RAND 10 * IP 1 + L\->C
  132.     IF DUP2 POS
  133.     THEN DROP
  134.     ELSE +
  135.     END
  136.       UNTIL DUP2 SIZE \<=
  137.       END 'AL' STO DROP { # 0h # 0h } PVIEW
  138.     \>>
  139.   setm
  140.     \<< 'LM' SWAP ROT PUT
  141.       IF LM LIST\-> DROP ROT NOT AND AND
  142.       THEN
  143.     IF LM 1 5 PUT CHECK LM 1 1 PUT CHECK OVER XOR
  144.     THEN 4 * 1 + 'LM' 1 ROT PUT
  145.     ELSE DROP
  146.     END
  147.       END
  148.       IF LM LIST\-> DROP SWAP NOT AND AND
  149.       THEN
  150.     IF LM 2 10 PUT CHECK LM 2 1 PUT CHECK OVER XOR
  151.     THEN 9 * 1 + 'LM' 2 ROT PUT
  152.     ELSE DROP
  153.     END
  154.       END PICT (104;68) LM LIST\-> DROP ROT
  155.       IF DUP NOT
  156.       THEN DROP " "
  157.       END ROT
  158.       IF DUP
  159.       THEN 64 + CHR
  160.       ELSE DROP " "
  161.       END + SWAP
  162.       IF DUP
  163.       THEN 82 + CHR
  164.       ELSE DROP " "
  165.       END + 2 \->GROB REPL
  166.     \>>
  167.   enter
  168.     \<<
  169.       IF
  170.     IF LM LIST\-> DROP AND AND
  171.     THEN LM CHECK
  172.     ELSE 0
  173.     END
  174.       THEN PICT (112;57) 'NM' INCR 1 \->GROB REPL
  175.       PICT (82;51) PICT (104;68) (120;62) SUB REPL
  176.     IF SCAN
  177.     THEN "---"
  178.     ELSE DUP MARK LIST\-> DROP SWAP 64 + CHR SWAP 82 + CHR + +
  179.     END 2 \->GROB PICT (108;51) ROT REPL clear
  180.       ELSE UNMARK BOOP
  181.       END
  182.     \>>
  183.   guess
  184.     \<< LM LIST\-> DROP
  185.       IF NOT AND AND
  186.       THEN PICT LM LIST\-> DROP2 L\->C 'GL' OVER STOT (-1;1) +
  187.     GROB 3 3 207020 GXOR clear
  188.       ELSE BOOP
  189.       END
  190.     \>>
  191.   SCAN
  192.     \<< LM LIST\-> DROP dirs SWAP 6
  193.       START LIST\-> ROLLD 6 \->LIST
  194.       NEXT ROT ROT L\->C
  195.       WHILE AL OVER POS NOT OVER
  196.         C\->R DUP 5 > SWAP 55 \<= AND OVER 0 > AND SWAP 70 \<= AND AND
  197.       REPEAT SWAP
  198.     CASE DUP2 2 GET + AL SWAP POS
  199.       THEN
  200.         DO LIST\-> ROLLD 6 \->LIST
  201.         UNTIL DUP2 2 GET + AL SWAP POS NOT
  202.         END
  203.       END DUP2 6 GET + AL SWAP POS
  204.       THEN
  205.         DO LIST\-> ROLL 6 \->LIST
  206.         UNTIL DUP2 6 GET + AL SWAP POS NOT
  207.         END
  208.       END
  209.     END SWAP OVER 1 GET +
  210.       END
  211.       IF AL OVER POS
  212.       THEN DROP2 1
  213.       ELSE SWAP 4 GET SWAP OVER + C\->R 10 / IP SWAP 7 /
  214.         ROT dirs SWAP POS 3 \->LIST 0
  215.       END
  216.     \>>
  217.   gmov
  218.     \<< 1 AL SIZE
  219.       FOR I PICT AL I GET (-2;2) + GROB 5 5 E0111111E0 GOR
  220.       NEXT PICT (87;68) # 22h # 7h BLANK REPL 0 WAIT
  221.       DROP AL SIZE Atoms \->TAG NM "Moves" \->TAG 0 0 1 GL SIZE
  222.       IF DUP2 \<=
  223.       THEN
  224.     FOR a
  225.       IF AL GL a GET POS
  226.       THEN 1 +
  227.       ELSE SWAP 1 + SWAP
  228.       END
  229.     NEXT
  230.       ELSE DROP2
  231.       END Right \->TAG SWAP Wrong \->TAG "Game over\010Your score:" DOERR
  232.     \>>
  233.   clear
  234.     \<< { 0 0 0 } 'LM' STO PICT (104;68) GROB 17 7 0 REPL
  235.     \>>
  236.   DRM
  237.     \<<
  238.       IF
  239.     IF LM LIST\-> DROP AND AND
  240.     THEN LM CHECK
  241.     ELSE LM LIST\-> DROP NOT AND AND
  242.     END
  243.       THEN LM MARK
  244.       END
  245.     \>>
  246.   CHECK
  247.     \<< LIST\-> DROP { 0 DROP 5 10 AND 5 10 > 1 0 DROP 1 1 > 1 1 AND 5 }
  248.       SWAP 3 * DUP 2 - SWAP SUB LIST\-> DROP 5 ROLL == 4 PICK 2 MOD ROT
  249.       EVAL ROT ROT == OR
  250.     \>>
  251.   MARK
  252.     \<< LIST\-> DROP
  253.       IF DUP
  254.       THEN dirs SWAP GET -2 /
  255.       END ROT ROT L\->C + (-1;1) + 'ML' OVER STO+ PICT SWAP
  256.       GROB 3 3 705070 GXOR
  257.     \>>
  258.   UNMARK
  259.     \<< 1 ML SIZE
  260.       IF DUP2 \<=
  261.       THEN
  262.     FOR I PICT ML I GET GROB 3 3 705070 GXOR
  263.     NEXT { } 'ML' STO
  264.       ELSE DROP2
  265.       END
  266.     \>>
  267.   L\->C
  268.     \<< DUP 7 * SWAP 2 MOD 2 / ROT + 10 * R\->C
  269.     \>>
  270.   STOT
  271.     \<<
  272.       IF OVER RCL OVER POS
  273.       THEN OVER RCL DUP ROT POS DUP2 1 SWAP 1 - SUB
  274.         ROT ROT 1 + OVER SIZE SUB + SWAP STO
  275.       ELSE STO+
  276.       END
  277.     \>>
  278.   BOOP
  279.     \<< 335 ,07 BEEP
  280.     \>>
  281.   FIELD
  282.     \<< "GROB 128 64 "
  283.       "0007C3C178FC7C111704000E000C7E4400884422980402211204000400640154" +
  284.       "008844201904020112040004C36C3192008FC320197C320F1204000444004F11" +
  285.       "0088442019040231124400044460419200884422980402211244000444644154" +
  286.       "0088C3C178F40C311783000E4408315400000000000000000000000000000000" +
  287.       "008F00E308F00E308F0000000000000000401014040101404010000000000000" +
  288.       "00401014040101404010000000000000F12028080202808020200002272A7800" +
  289.       "102028080202808020200006B82A04141010C700F10C700F10C7000AA82A3410" +
  290.       "F02028080202808020280002A849041401202808020280802028000227887800" +
  291.       "0140101404010140401010000000000001401014040101404010100000000000" +
  292.       "118F00E308F00E308F00200000020000E0401014040101404010100000040000" +
  293.       "004010140401014040101000008F000080202808020280802028000000040000" +
  294.       "C0202808020280802028000000020000A010C700F10C700F10C7000000000000" +
  295.       "90202808020280802028000000000000F1202808020280802028000000000000" +
  296.       "8040101404010140401010000000000080401014040101404010100000000000" +
  297.       "808F00E308F00E308F00200000C1000080401014040101404010100000220000" +
  298.       "00401014040101404010100000200000E0202808020280802028000000C10000" +
  299.       "112028080202808020280000000200000110C700F10C700F10C700002222E300" +
  300.       "01202808020280802028000022C18000E0202808020280802028000041008000" +
  301.       "01401014040101404010100080E3800001401014040101404010100041148000" +
  302.       "118F00E308F00E308F00200022148000E040101404010140401010002A088000" +
  303.       "00401014040101404010100008080000E0202808020280802028000004001000" +
  304.       "112028080202808020280000080800001110C700F10C700F10C700002A082200" +
  305.       "8020280802028080202800002214220040202808020280802028000022142200" +
  306.       "204010140401014040101000A2E32200104010140401014040101000A2002200" +
  307.       "108F00E308F00E308F00200063222200F140101404010140401010002222C100" +
  308.       "0040101404010140401010000022000040202808020280802028000000410000" +
  309.       "602028080202808020280000004100004010C700F10C700F10C7000000800000" +
  310.       "4020280802028080202800000080000040202808020280802028000000000000" +
  311.       "4040101404010140401010000000000040401014040101404010144000080000" +
  312.       "408F00E308F00E308F00244000080000E0001014040101404010144E44EC17E6" +
  313.       "000010140401014040101C719209882900002808020280802028044F11E98829" +
  314.       "0000280802028080202804418219A8290000C700F10C700F10C7044E44E11729" +
  315.       OBJ\-> DUP 'FIELD' STO
  316.     \>>
  317.   dirs { (0;-10) (-7;-5) (-7;5) (0;10) (7;5) (7;-5) }
  318.   PPAR { (-6;5) (124;68) X 0 (0;0) FUNCTION Y }
  319. END
  320.  
  321. * Software like this is distrubuted freely on STORC meetings.  If you're *
  322. * Dutch, and have a 28C, 28S or 48SX, and like to receive STORC          *
  323. * newsletter and join our meetings, contact STORC,                       *
  324. * Christ van Willegen, Dordognelaan 45, 5627 HB  Eindhoven, Netherlands. *
  325. --
  326. |                 | "Never imagine yourself not to be otherwise than what |
  327. | Jurjen N.E. Bos | it might appear to others that what you were or might |
  328. |                 | have been was not otherwise than what you had been    |
  329. |  jurjen@cwi.nl  | would have appeared to them to be otherwise."         |
  330.  
  331.  
  332.